COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	integer arrays
C00019 ENDMK
C⊗;
integer arrays
BBoxArray
BBoyArray
BBdxArray
BBdyArray

integer
bbox
bboy
bbdx
bbdy
bbxl
bbxr
bbyl
bbyh

boolean
emptychar
bndboxvalid

define
bitloc(x)=⊂((x+(1000*bitsperwd+hw-1))mod bitsperwd)⊃ # number of
	bits to the left of bit x, copied from mfrast;


charsegptr[charcode]
if not vectorwidths then	Is vectorwidths to be false?

charwx
charwd				Is the read or integer?
charwy←0.0		This would seem to indicate that charwy was real!
charcode				char_code
charbits←bbdx*bbdy			char_bits ← cols * rows
charwords←2*((charbits+31) div 32)	2*((char_bits + 31) div 32)
padbits←16*charwords-charbits;			not used
charsegptr				char_seg_ptr ← oc_byte_no div 2

Wout(doveroc,-bbdy)			oc_halfword(min_y-1-max_y)
Wout(doveroc,bbdx-1)	  		oc_halfword(max_x-min_x)


bc					bc
ec					ec
nc					nc
charsegfilepos				char_seg_file_pos = 1536
fontsegstart				← char_seg_file_pos - (8+2)*nc
fontsegend				← (oc_byte_no) div 2 (at right time)
relptrbase				rel_ptr_base

fontfacebyte		*** WHERE DOES ONE GET THIS? ***

useto(ch,1) # reset file position to beginning;  *** HOW TO DO THIS IN PASCAL? ***

bytecount[doveroc]←0;			oc_byte_no ← 0; 

IX(1,12) # header for family-name IX;	*** WHAT DOES THIS MEAN? ***
fontidentifier,20);			*** WHERE DOES ONE GET THIS? ***
IX(5,11) # header for orbit-chars IX;	*** AND ALSO THIS? *** 
fontfacebyte) # logical size encoded as face byte;
Wout(doveroc,(xresolution*ppi*10/magnification)+0.5) # X resolution in
		units of pixels/(10 inches);
Wout(doveroc,(yresolution*ppi*10/magnification)+0.5) # Y resolution in
		units of pixels/(10 inches);
IX(0,1) # endIX;			*** THIS THING AGAIN? ***

		newwidth←(CharWidthX[c]*xresolution*(2↑16))+0.5;
		Dout(doveroc,newwidth);
		newwidth←(CharWidthY[c]*yresolution*(2↑16))+0.5;
		Dout(doveroc,newwidth);
		Wout(doveroc,BBoxArray[c]);
		Wout(doveroc,BBoyArray[c]);
		Wout(doveroc,BBdxArray[c]);
		Wout(doveroc,BBdyArray[c]);
		end
	  else	begin
		integer i;
		for i←1 thru 7 do Wout(doveroc,0);
		Wout(doveroc,-1) # marks a non-existent character;
		end;
relptrbase←charsegfilepos-2*nc;
DEBUGONLY if bytecount[doveroc]≠relptrbase*2 then confusion;
for c←bc thru ec do
	if charsegptr[c]≠-1 then Dout(doveroc,charsegptr[c]-relptrbase)
		else Dout(doveroc,-1);
end;


comment Routines for presswd mode.;

procedure makewd # stores the width of current character away for .wd file;
begin
integer ch;
ch←openofil(presswd);
if not bndboxvalid then bndbox;
comment the following couple of statements also appear in makeoc, but
	repeating them is OK;
if not vectorwidths then
	begin
	charwx←charwd;
	charwy←0.0;
	end;
CharWidthX[charcode]←charwx;
CharWidthY[charcode]←charwy # end of repetition;
if charwx<charwxmin then charwxmin←charwx;
if charwx>charwxmax then charwxmax←charwx;
if charwy<charwymin then charwymin←charwy;
if charwy>charwymax then charwymax←charwy;
if not emptychar then
	begin comment update font bounding box;
	if bbxl<bbxlmin then bbxlmin←bbxl;
	if bbxr>bbxrmax then bbxrmax←bbxr;
	if bbyl<bbylmin then bbylmin←bbyl;
	if bbyh>bbyhmax then bbyhmax←bbyh;
	end;
end;

procedure wdcloseout;
begin
integer c,bc,ec,nc;
boolean fixedx, fixedy;
integer wdlen # length of data segment in 16-bit words;
real fbbox, fbboy, fbbdx, fbbdy # font bounding box metrics in points;
  procedure RealWout(real r) # scale and output one numeric value;
	begin integer int;
	int←((r*1000/designsize) + 0.5);
	if abs(int)≥(2↑15-1) then
	 error("Distance of "&cvf(r)&" points exceeds bounds of .WD format.");
	Wout(presswd,int);
	end;

for bc←0 step 1 until '177 do if CharWidthX[bc]≠nonexistentcharflag then done;
for ec←'177 step -1 until 0 do if CharWidthX[ec]≠nonexistentcharflag then done;
if bc>ec then
	begin
	bc←1; ec←0;
	error("No characters in this font");
	end;
nc←ec-bc+1;

if fontfacebyte<0 or fontfacebyte>255 then
	error("Font face byte out of bounds");
while rotation>360 do rotation←rotation-360;
while rotation<0 do rotation←rotation+360;

if charwxmax=charwxmin then fixedx←true else fixedx←false;
if charwymax=charwymin then fixedy←true else fixedy←false;
wdlen←5  comment for header;
	+(if fixedx then 1 else nc) comment for x-widths;
	+(if fixedy then 1 else nc); comment for y-widths;

if bbxlmin>bbxrmax then 
	comment font is entirely empty characters!;
	fbbox←fbboy←fbbdx←fbbdy←0.0
   else
	begin
	fbbox←bbxlmin/xresolution;
	fbboy←bbylmin/yresolution;
	fbbdx←(bbxrmax-bbxlmin+1)/xresolution;
	fbbdy←(bbyhmax-bbylmin+1)/yresolution;
	end;

Wout(presswd,IX(1,12)) # header for family-name IX;
Wout(presswd,0) # name code;
BCPLout(presswd,fontidentifier,20);
Wout(presswd,IX(4,9)) # header for orbit-chars IX;
Bout(presswd,0) # name code again;
Bout(presswd,fontfacebyte) # logical size encoded as face byte;
Bout(presswd,bc); Bout(presswd,ec);
Wout(presswd,0) # physical size field: 0 means scalable;
Wout(presswd,(60*rotation)+0.5) # rotation in minutes of arc;
Dout(presswd,22) # starting file pos of font segment (right after endIX);
Dout(presswd,wdlen) # length of data segment;
Wout(presswd,IX(0,1)) # endIX;

comment output the width table;
RealWout(fbbox) # X offset of font bounding box;
RealWout(fbboy) # Y offset of font bounding box;
RealWout(fbbdx) # X dimension of font bounding box;
RealWout(fbbdy) # Y dimension of font bounding box;
Wout(presswd,(if fixedx then 1 lsh 15 else 0)+
	(if fixedy then 1 lsh 14 else 0)) # fixedflags;
if fixedx then RealWout(charwxmax) 
 else for c←bc thru ec do
	if CharWidthX[c]=nonexistentcharflag then
		Wout(presswd,1 lsh 15)
	else RealWout(CharWidthX[c]);
if fixedy then RealWout(charwymax) 
 else for c←bc thru ec do
	if CharWidthX[c]=nonexistentcharflag then
		Wout(presswd,1 lsh 15)
	else RealWout(CharWidthY[c]);
if (bytecount[presswd] mod 4)≠0 then
	Wout(presswd, 0) # pad to 32-bit-word boundary, so that byte-output
		routines will flush their buffers and get the data to disk;
end;